The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/tetrisx.src

Text File | 1991-05-29 | 8KB | 234 lines

%%HP:T(3)F(.);
@ TETRISX
@ by Jon Loschke
DIR
  INTRO
    \<< PICT PURGE { # 0h # 28h } { # 82h # 28h } LINE { # 0h # 0h } PVIEW
1 SF TLST OBJ\-> DROP 1 24
      START FLST SWAP GET SWAP GET SWAP PLST 6 RAND * IP 1 + GET 'p' STO
ANIM DROP
      NEXT 1 CF 1 5
      START LINE 100 .1 BEEP
      NEXT PICT { # Ch # 0h } "Brought to you by:" 2 \->GROB REPL PICT
{ # 22h # 8h } "Jon Loschke" 2 \->GROB REPL 2 WAIT PLAY
    \>>
  PLAY
    \<< "Enter starting level,\010(0..4, -1 for rewind)" ":Level:" INPUT OBJ\->
      IF DUP 0 <
      THEN DROP r FP RDZ r IP
      ELSE RAND 8 TRNC DUP RDZ OVER + 'r' STO
      END 'v' STO 'b' 'a' STO RAND 7 * IP 1 + 'OBN' STO 1 5 CF CF 0 'PNTS' STO
RUN
    \>>
  CONT.
    \<<
      IF CT SIZE
      THEN 3 SF RUN
      ELSE PLAY
      END
    \>>
  PNTS 155
  HI 2352
  NXT
    \<< 2 FC?C
      \<< 2 SF
      \>> IFT
    \>>
  EXIT
    \<< 440 .1 BEEP
      WHILE KEY
      REPEAT DROP
      END 1 2 CF CF
      IF PNTS HI >
      THEN PNTS DUP 'HI' STO "New High Score" \->TAG 440 .1 BEEP
      ELSE PNTS "Score" \->TAG
      END
    \>>
  r 4.44273096
  v 4
  BONUS
    \<< 0 \-> t
      \<< # F6h NEG
        DO # 100h + # 1002003004005h OVER DUP2 # FA5Fh XFIG # 5h + # FA5Fh
XFIG 1 't' STO+ 880 .005 BEEP
        UNTIL TLIN # 0h \=/
        END DROP PICT { # 31h # 5h } "BONUS" 2 \->GROB NEG REPL PICT { # 37h
# Dh } t 5 v + * \->STR 2 \->GROB NEG REPL 1 t
        START 5 v + ADDP
        NEXT 1 WAIT
      \>>
    \>>
  PSE
    \<< PNTS v l a OBN 5 \->LIST 'CT' STO PICT { # 2Ch # 0h } DUP2 { # 53h
# 3Bh } SUB DUP 'CT' STO+ GXOR KILL
    \>>
  RUN
    \<<
      DO MKSCR
        IF 3 FC?C
        THEN 16 v 2 * + 'l' STO BRIK
        ELSE PICT { # 2Ch # 0h } CT OBJ\-> DROP 'OBN' STO 'a' STO 'l'
STO 'v' STO 'PNTS' STO REPL { } 'CT' STO
        END 0 ADDP PICT { # 5Dh # 10h } l \->STR 1 \->GROB REPL PICT { # 6Ch
# 3Ah } v \->STR 1 \->GROB GXOR
        DO delay OBN 'OB1' STO FLST DUP OBN GET 1 GET # B06h # 0h XFIG
RAND 7 * IP 1 + DUP 'OBN' STO GET 1 DUP 'OB2' STO GET # B06h # A5A5h 2
FS? * XFIG FLST OB1 GET 1 GET # Eh 1 CF PLST DUP SIZE RAND * IP 1 +
GET 'p' STO ANIM 4 v + ADDP DROP PACK MEM DROP
          IF 3 FS?C
          THEN PSE
          END
        UNTIL FULL 5 FS? OR
        END BONUS
      UNTIL 5 FC?C
      END EXIT
    \>>
  CT { }
  b .05
  PLST { # F99Fh # FBDFh # FDBFh # FD9Fh # FFBFh # FB9Fh # FFFFh # 9669h }
  BRIK
    \<< v 8 MIN
      WHILE DUP
      REPEAT 1 4
        START # 0h 10 RAND * IP # F0Bh + # 100h 4 PICK * - # F99Fh XFIG
        NEXT 1 -
      END DROP
    \>>
  l 23
  p # 9669h
  ANIM
    \<< DUP2 p XFIG
      DO
        IF 1 FC?
        THEN RK2 RK2 RK2 RK2
        END DUP2 # 0h XFIG # 100h + DUP2 # 0h + TFIG
        IF # 0h ==
        THEN DUP2 p XFIG
        ELSE # 100h - p XFIG 0
        END
      UNTIL DUP 0 ==
      END
    \>>
  TLST { { # 46h # 2Ah } { # 5Ah # 3Fh } { # 5Ah # 2Ah } { # 46h # 3Fh }
{ # 32h # 3Fh } { # 3Ch # 38h } { # 3Ch # 38h } { # 32h # 31h }
{ # 32h # 31h } { # 3Ch # 2Ah } # 1h 3 6 # 9h 1 2 # 11h 1 4 # 1Ch 4 4
# 4h 1 4 # Eh 3 6 # 18h 4 6 # 7h 4 1 # 1Bh 4 6 # 2h 1 3 # 1Bh 2 4 # 8h
1 3 # 15h 1 7 # Eh 2 2 # 7h 4 1 # 1Ch 2 6 # 18h 4 6 # 2h 2 4 # 9h 1 2
# 15h 1 5 # Fh 2 2 # Fh 1 2 # 14h 1 7 # 3h 2 6 }
  SFX
    \<< 440 1760
      FOR i i .01 BEEP 165
      STEP
    \>>
  a .036
  OB1 5
  OB2 1
  OBN 2
  CSTL
GROB 42 64 FD7FD3ECB130154154A66B10B57B55A60E00A42A42AC3400A47A45A06E00A44A4BA66B10EC7EC5ECB1300000000000000000010000000000010000001777C700000011120100000017720300000011128100000077120100000000008200000000004400000000002800000000002800000000004400000000008300000000008200000000008200000000008200000000008300000000204500000000204500000008F0450000000020450400000062290400000032290F100000AF290400000022FF1C000000561416000000531414000008221F14000008A2141A000004271C1A00000297161510000ACA0415100006AA0494200002DA1A4940000CBA2E42500004AA2BD4600004AA2559400004AAAAAF300004CF95B0200004409AA020000C701F9F300004401150400004CF11FFF00004202F3080000220A02080000210404080000EFFFFFFF000039429429100829429429200CFFFFFFFF7004000C70004004000EF0004004000EF0004004000EF0004004000EF000400CFFFFFFFF700
  IPIC
GROB 40 64 0E0000000001100000810187E47E810E401D01100050150F9101501501810E87E40E000000000000FFFFFFFFFF100000000810000000081000000008100000000810000000081000000008100000000810000000081000000008FFFFFFFFFF000000000000000000000CCD1E4ACE04590AAA220C490EEA4E045902AA8204D902AE6E000000000000F700CF70007700CE6000770042400036004E400036004240001400C26000F700CF700000000000F7F7F7CFFFF514D74BA87436174AAD14361448DD74771749ADF577D74BADF7F7F7CFFF0000000000033770000005555000000535700000055510000003571000000000000000000000000000000000000FFF300000033A3000000BAB3000000B2A3000000BAB30000003322000000FFF300000000000000006AA309EAE09A210B2A409A210FE4405A210D2A40AE2109EA4
  MKSCR
    \<< ERASE { # 54h # 3Ch } { # 54h # 0h } OVER LINE { # 2Bh # 3Ch }
DUP ROT LINE { # 2Bh # 0h } LINE PICT { # 0h # 0h } IPIC REPL PICT
{ # 59h # 0h } CSTL REPL { # 0h # 0h } PVIEW
    \>>
  RK2
    \<<
      IF KEY
      THEN
        IF { 34 36 35 25 54 26 16 11 } SWAP POS DUP
        THEN {
          \<< # 1h NEG MSIDE
          \>>
          \<< # 1h MSIDE
          \>>
          \<< 1 SF
          \>> ROTF
          \<< CLEAR KILL
          \>> NXT
          \<< 3 SF
          \>>
          \<< OFF
          \>> } SWAP GET EVAL
        ELSE DROP
        END
      END a WAIT
    \>>
  ADDP
    \<< 'PNTS' STO+ PICT { # 5h # Ah } PNTS 2 \->GROB REPL
    \>>
  TFIG  @ by Erik Bryntse; convert with ASC->
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
  XFIG  @ by Erik Bryntse; convert with ASC->
"CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56
507146134152739E1B20F880029916912014313234E4A201428A2606EB016915
271011741431321428A63E16915271001741431321428A68C1691567AFAAF122
A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341
19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601
42164808CE7C9"
  ROTF
    \<< DUP2 # 0h XFIG FLST OB1 GET OB2 1 -
      IF DUP 0 \<=
      THEN DROP DUP SIZE
      END DUP \-> OS2
      \<< GET SWAP DUP2 # 0h + TFIG
        IF # 0h ==
        THEN ROT DROP OS2 'OB2' STO
        ELSE SWAP DROP
        END DUP2 p XFIG
      \>>
    \>>
  delay
    \<< a .001 - DUP
      IF 0 \<=
      THEN DROP .000000001
      END 'a' STO
    \>>
  MSIDE
    \<< \-> CD
      \<< DUP2 # 0h XFIG CD + DUP2 # 0h + TFIG
        IF # 0h \=/
        THEN CD -
        END DUP2 p XFIG
      \>>
    \>>
  FLST { { # 100101102201h # 1101201100h # 200201202101h # 1101201102h
} { # 200201202203h # 2102202302h } { # 1002101102h } {
# 100101102202h # 1101201200h # 100200201202h # 1101201002h } {
# 100101201202h # 1101100200h } { # 102200201202h # 101201202001h
# 100101102200h # 1101201000h } { # 200201101102h # 100101201000h } }
  TLIN
    \<< DUP # 101102103104105h SWAP DUP2 # 0h + TFIG ROT ROT # 5h + TFIG +
    \>>
  PACK
    \<< # D0Ah
      DO TLIN
        IF # 4h ==
        THEN P2
        ELSE # 100h -
        END
      UNTIL DUP # 200h <
      END
      IF l 0 \<=
      THEN 5 SF 'v' INCR DROP
      END DROP
    \>>
  P2
    \<< PICT { # 5Dh # 10h } 'l' DECR
      IF DUP 0 <
      THEN NOT
      END \->STR " " + 1 \->GROB REPL 25 v 2 * + ADDP DUP # F00h AND SRB 4
* 3 + # 28h SWAP 2 \->LIST SFX PICT SWAP { # 55h # 8h } SUB PICT { # 28h
# Ch } ROT REPL
    \>>
  FULL
    \<< # 101102103104105h # 10Ah DUP2 # 0h + TFIG ROT ROT # 5h + TFIG + # 0h >
    \>>
END